This script is intended to assist in the creation of animated gifs for web pages. NOTE this program does not create animated gifs itslf. It only helps design the anim or animbrush that is used as a source for creating the animated gifs. The animated gifs have to be created with other programs such as Cloanto's DefineAnimGif.pprx and SaveAnimGif.pprx. However since this runs on Personal Paint. and for convenience, this script will call on Personal Paint's 'SaveAnimGiif.pprx' (in slightly modified form) and pass information to it.
*/
IF ARG(1, EXISTS) THEN
PARSE ARG PPPORT
ELSE
PPPORT = 'PPAINT'
IF ~SHOW('P', PPPORT) THEN DO
IF EXISTS('PPaint:PPaint') THEN DO
ADDRESS COMMAND 'Run >NIL: PPaint:PPaint'
DO 30 WHILE ~SHOW('P',PPPORT)
ADDRESS COMMAND 'Wait >NIL: 1 SEC'
END
END
ELSE DO
SAY "Personal Paint could not be loaded."
EXIT 10
END
END
IF ~SHOW('P', PPPORT) THEN DO
SAY 'Personal Paint Rexx port could not be opened'
EXIT 10
END
ADDRESS VALUE PPPORT
OPTIONS RESULTS
OPTIONS FAILAT 10000
/*********ANIM IS SET UP****WHAT TO DO NEXT***************************/
openWAD= getclip('openWAD'); if openWAD = "" then DO
/*******************ENSURES SCREEN NOT TOO SMALL & STUFF IS WITHIN SCREEN*****************/
accept = 0
GET 'SCREENW'
scw = result
if scw >= 640 then DO
GET 'SCREENH'
sch = result
if sch >= 400 then DO
GET 'IMAGEW'
imgw = result
if imgw <= scw then DO
GET 'IMAGEH'
imgh = result
if imgh <= sch then accept = 1
END
END
END
if accept = 0 then DO
Requestnotify 'TITLE "CHANGE SCREEN or IMAGE SIZE" PROMPT "For viewability, screen size must be 640x 400 or greater, and image size equal or less the screen size"'
EXIT 0
END
/********/
call TITLEPAGE
RequestResponse 'TITLE "OPEN NEW PROJECT" PROMPT "Opening a project requires an animbrush be present. Load an animbrush?"'
if rc~=0 then EXIT 0
if rc=0 then call LOADER
END
/********THE ABOVE IS DONE ONLY AT VERY START********/
numcolors2=getclip('numcolors2')
GET 'COLORS'
numcolors=result
if numcolors = 256 then DO; RequestResponse 'PROMPT "You must start on the source page. Proceed if okay. Cancel if not."';if rc~=0 then EXIT 0;END
if numcolors = numcolors2 then DO
switchenvironment
GET 'COLORS'
numcolors=result
end
SETFRAMEPOSITION 1
REQUESTER:
txt_gad_title = 'WEB ANIM DESIGNER 0.92 by A.Paabo for use with Personal Paint 7.+'
if delx0 < 0 then DO /*means a value of -1 meaning identical*/
delx0 = 0
dely0 = 0
delx1 = 0
dely1 = 0
END
dx0 = X0 + delx0
dy0 = Y0 + dely0
dx1 = X0 + delx1 + 1
dy1 = Y0 + dely1 + 1
Definebrush dx0 dy0 dx1 dy1
SwitchENvironment /*to switch env*/
SETFRAMEPOSITION frm+1
GETFRAMEDELAY frm
delay = result
Usebrushpalette
remapimage
SetBrushHandle UPPERLEFT
if dispose = 0 then PutBrush dx0 dy0
if frm <frames-1 then ADDFRAMES 1 AFTER
if dispose = 1 then PutBrush dx0 dy0
FreeBrush FORCE
SETPEN 'FOREGROUND' numcolors2-3
if drawrect=1 then DrawRectangle dx0 dy0 dx1 dy1 /*the delta*/
SETFRAMEDELAY delay
SWITCHENVIRONMENT
END
END
/***********************/
SwITCHENVIRONMENT
SETFRAMEPOSITION 1
PLAY
/***********************************/
/*********************************************/
EXIT
/*****************************************/
GLOBALAREA:
maxdx = 0
maxdy= 0
mindx = 4000
mindy = 4000
DO frm = 1 to frames
SETFRAMEPOSITION frm
GetImageAttributes 'BOUNDARIES'
PARSE VAR RESULT dx0 dy0 dx1 dy1 rest
if dx0 < mindx then mindx = dx0
if dy0 < mindy then mindy = dy0
if dx1 > maxdx then maxdx = dx1
if dy1 > maxdy then maxdy = dy1
END
X0 = mindx
Y0 = mindy
X1 = maxdx
Y1 = maxdy
call setclip('X0', X0)
call setclip('Y0', Y0)
call setclip('X1', X1)
call setclip('Y1', Y1)
RETURN
/***********************************************/
TEXTSRECT:
GET 'IMAGEW'
imgw = RESULT
Xmid = TRUNC(imgw/2)
SETPEN 'FOREGROUND' numcolors2-2
Text 'TEXT "SIMULATION OF ANIM GIF ON WEB PAGE" "fonts:" "times" "20" "of" "'Xmid'" "40" CENTER'
Text 'TEXT "(IF ACTIVE) LARGE RECTANGLE SHOWS GLOBAL ANIMGIF SIZE. SMALLER RECTANGLES SHOW FRAME SIZES "fonts:" "times" "10" "of" "'Xmid'" "60" CENTER'
if transp=1 then DO
if dispose = 1 then Text 'TEXT "angif setting at TRANSPARENCY=1 DISPOSE=1" "fonts:" "times" "15" "of" "'Xmid'" "70" CENTER'
if dispose = 0 then Text 'TEXT "angif setting at TRANSPARENCY=1 DISPOSE=0" "fonts:" "times" "15" "of" "'Xmid'" "70" CENTER'
END
if transp=0 then DO
if dispose = 1 then Text 'TEXT "angif setting at TRANSPARENCY=0 DISPOSE=1" "fonts:" "times" "15" "of" "'Xmid'" "70" CENTER'
if dispose = 0 then Text 'TEXT "angif setting at TRANSPARENCY=0 DISPOSE=0" "fonts:" "times" "15" "of" "'Xmid'" "70" CENTER'
eND
if optimization = 0 then Text 'TEXT "OPTIMIZATION=NONE (CONST FRAME & POSTITION)" "fonts:" "times" "15" "of" "'Xmid'" "85" CENTER'
if optimization =1 then Text 'TEXT "OPTIMIZATION=BOUNDARIES" "fonts:" "times" "15" "of" "'Xmid'" "85" CENTER'
if optimization = 2 then Text 'TEXT "OPTIMIZATION=DELTA" "fonts:" "times" "15" "of" "'Xmid'" "85" CENTER'
freebrush FORCE
if drawrect=1 then DrawRectangle X0 Y0 X1 Y1
RETURN
/*********************************************/
LOADER:
CLEARIMAGE
FREEENVIRONMENT FORCE
SWITCHENVIRONMENT
GetBrushAttributes 'FRAMES'
frames = RESULT
IF frames < 2 then DO
Loadanimbrush
if rc~=0 then EXIT 0
END
GetbrushAttributes 'COLORS'
numcolors = RESULT
Set 'FORCE "COLORS='numcolors'"'
copyenvironment FORCE
Set 'FORCE "TRANSP= 1"'
GET 'IMAGEW'
imgw = RESULT
GET 'IMAGEH'
imgh = RESULT
imgmid = TRUNC(imgw/2)
GetBrushAttributes 'FRAMES'
frames = RESULT
GetBrushAttributes WIDTH
width = result
if width > imgw-100 then DO; Requestnotify 'TITLE "ANIMBRUSH TO WIDE" PROMPT "The animbrush is too wide. Use larger screen size"';EXIT 0; END
GetBrushAttributes HEIGHT
height = RESULT
if height > imgh-100 then DO; Requestnotify 'TITLE "ANIMBRUSH TO WIDE" PROMPT "The animbrush is too high. Use larger screen size."'; EXIT 0; END
x0 = TRUNC((imgw-width)/2)
y0 = TRUNC((imgh-height)/2)
x1 = x0 + width
y1 = y0 + height
setbrushhandle UPPERLEFT
UseBrushPalette
GetBrushAttributes 'TRANSPARENCY'
transp = RESULT
IF transp=0 then transpcol = 0
If transp >0 then DO
GetBrushAttributes 'TRANSPARENTCOLOR'
transpcol = RESULT
setpen 'BACKGROUND' transpcol
END
/************CLEAR TO ABRS TRANSP COLOR & STAMP DOWN*************************/
GetBrushInfo 'ANNOTATION'
frame_annot = RESULT
delayannot = 0
loop = -1
delay. = 0
IF WORD(frame_annot, 1) = 'LOOP' & WORD(frame_annot, 3) = 'DELAY' THEN DO
delayannot=1
loop = WORD(frame_annot, 2)
IF ~DATATYPE(loop, 'W') THEN
loop = -1
DO frm = 1 TO frames
del = WORD(frame_annot, 3+frm)
IF DATATYPE(del, 'W') THEN
delay.frm = del
delay.frm = TRUNC(delay.frm*(60/100))
END
END
SETPEN 'BACKGROUND' transpcol
ClearImage
ADDFRAMES frames AFTER
DO frm = 1 TO frames
SETFRAMEPOSITION frm
if delayannot=1 then SETFRAMEDELAY delay.frm
if delayannot = 0 then SETFRAMEDELAY 10
SetBrushAttributes 'FRAMEPOSITION' frm
Usebrushpalette
Putbrush X0 y0
END
SETFRAMEPOSITION 1
call setclip('X0', X0)
call setclip('Y0', Y0)
call setclip('X1', X1)
call setclip('Y1', Y1)
call setclip('openWAD', 1)
freebrush /*not needed as we make the preview version from the image*/
PLAY 3
Requestnotify 'TITLE "PROJECT IS NOW SET UP" PROMPT " NEW PROJECT IS SET UP. Always keep area around the animation a perfectly clean animation transparent color. You can work on this anim now. Then enter Web Anim Designer at ANY time to render your animation to a simulation of an animated gif on a web page."'
Requestresponse 'TITLE "HANDING OVER TO SAVEANIMGIF.PPRX" PROMPT "This operation hands an annotated animbrush over to a modified version of Cloanto-s (GIF-licenced) SaveAnimGif.pprx, which has been copied to the bottom of WebAnimDesigner.pprx. The settings in W.A.D.determine the parameters for saving. Thus the SaveAnimGif settings requester is not needed and will not appear. Continuous looping is assumed. "'
if rc ~=0 then EXIT 0
END
GETFRAMES
frames = result
Setframeposition 1
posit = 1
X0 = GETCLIP('X0')
Y0 = GETCLIP('Y0')
X1 = GETCLIP('X1')
Y1 = GETCLIP('Y1')
/********get animation project info if exists****************/
GetProjectInfo 'COPYRIGHT'
annot = RESULT
/***get time delays from source animation, convert to 100ths if asked***/
DO frm = 1 to frames
GetFrameDelay 'FRAME' frm
del = RESULT
delay.frm = TRUNC((del * 100/60) + 0.5)
END
/*******make animbrush********/
DefineBrush X0 Y0 X1 Y1 'FRAMES' frames
/*******annotate animbrush with delay timings********/
loop = 1
frame_annot = 'LOOP' loop 'DELAY'
DO frm = 1 TO frames
frame_annot = frame_annot delay.frm
END
SetBrushInfo 'ANNOTATION "'frame_annot'"'
SetBrushInfo 'COPYRIGHT "'annot'"'
If operation = 2 then EXIT 0
/****************continue into other scripts*********************/
/*********NOTE: THESE CALL ON THIRD PARTY SCRIPTS THAT***********/
/**************ACTUALLY CREATE THE ANIMATED GIFS.*****************/
call setclip('dispose', dispose)
call setclip('optimization', optimization)
CALL WADSaveAnimGif
EXIT 0
WADSaveAnimGif:
/**********INFO FROM WEB ANIM DESIGNER***********/
/*****not provided in annotated animbrush********/
/*MODIFIED SaveAnimGif.pprx 1.7. The modifications are simple ones to allow the above host program to pass to it the parameters this program uses. Since the parameteers are passed to it, the settings requester is not needed, and that portion of the script has been removed. Also, to permit the creation of various situations other than just delta-nontransp-nodispose and boundaries-transp-dispose, explicit control of the host's variable 'optimization' is simply introduced, and more output possibilities than the above two are permitted. All modified sections are marked*/
/****MODIFICATION****remove entry script since it is already acheived at the top of this overall script***/
/*******MODIFICATION ****as settings requester removed, gadget texts relating to it removed. These remain. Non English excluded in this version***/
txt_title_req = 'Save GIF Anim-Brush'
txt_err_oldclient = 'This script requires a newer_version of Personal Paint'
txt_err_oldlib = 'This script requires a newer_version of the GIF library'
txt_err_notabsh = 'The current brush_is not an anim-brush'
txt_err_notemp = 'No space for temporary brush'
txt_err_nomem = 'Not enough memory'
txt_err_nosave = 'File I/O error'
Version 'REXX'
IF RESULT < 7 THEN DO
RequestNotify 'PROMPT "'txt_err_oldclient'"'
EXIT 10
END
LockGUI
GetBrushAttributes 'FRAMES'
frames = RESULT
IF frames < 2 THEN DO
RequestNotify 'PROMPT "'txt_err_notabsh'"'
UnlockGUI
EXIT 0
END
GetBrushNumber
bshnum = RESULT
SetCurrentBrush 'UNUSED'
IF RC ~= 0 THEN DO
RequestNotify 'PROMPT "'txt_err_notemp'"'
UnlockGUI
EXIT 0
END
GetBrushNumber
tbshnum = RESULT
SetCurrentBrush 'BRUSH' bshnum
GetBrushInfo 'ANNOTATION'
frame_annot = RESULT
loop = -1
delay. = 0
IF WORD(frame_annot, 1) = 'LOOP' & WORD(frame_annot, 3) = 'DELAY' THEN DO
loop = WORD(frame_annot, 2)
IF ~DATATYPE(loop, 'W') THEN
loop = -1
DO frm = 1 TO frames
del = WORD(frame_annot, 3+frm)
IF DATATYPE(del, 'W') THEN
delay.frm = del
END
END
use_loop = (loop >= 0)
IF loop < 0 THEN
loop = 0
fnlen = LENGTH(frames)
dsel = 1
do_req = 1
deltype = 0
GetBrushInfo 'COPYRIGHT'
annot = RESULT
max_annot_size = LENGTH(annot) * 2
IF max_annot_size < 200 THEN
max_annot_size = 200
GetBrushAttributes 'TRANSPARENCY'
transp = RESULT
IF transp ~= 1 THEN
transp = 0
/*****MODIFICATION*****all matters pertaining to the settings requester have been removed since the host provides all settings data. We continue at the following lines*****/
IF ~use_loop THEN
loop = -1
frame_annot = 'LOOP' loop 'DELAY'
DO frm = 1 TO frames
frame_annot = frame_annot delay.frm
END
SetBrushInfo 'ANNOTATION "'frame_annot'"'
RequestFile '"'txt_title_req'" SAVEMODE'
IF RC = 0 THEN DO
PARSE VALUE RESULT WITH '"' fname '"'
tempfile = 'T:PP_AnGif.'PRAGMA('ID')
GetBrushAttributes 'FRAMEFIRST'
sv_frmin = RESULT
GetBrushAttributes 'FRAMELAST'
sv_frmax = RESULT
GetBrushAttributes 'LENGTH'
sv_frlen = RESULT
GetBrushAttributes 'FRAMEPOSITION'
sv_frpos = RESULT
Get 'ICONS'
sv_icons = RESULT
GetBrushAttributes 'WIDTH'
bwidth = RESULT
GetBrushAttributes 'HEIGHT'
bheight = RESULT
GetBrushAttributes 'TRANSPARENTCOLOR'
transpcol = RESULT
GetBrushAttributes 'COLORS'
bcolors = RESULT
plt_size = bcolors * 3
Get 'PATHBSH'
PARSE VAR RESULT '"' sv_pathbsh '"'
/*****MODIFICATION****we remove the following lines because they only provide two options
IF transp = 1 THEN
pckinfo = '09'x
ELSE
pckinfo = '00'x ******/
/*******MODIFICATION*****we replace them with these lines which provide a few more*******/
if transp = 0 then DO
if dispose = 0 then pckinfo = '06'x /*notrans nodisp*/
if dispose = 1 then pckinfo = '08'x /*notrans & dispose*/
END
if transp = 1 then DO
if dispose = 0 then pckinfo = '05'x /*trans & nodispose*/
if dispose = 1 then if transp = 1 then pckinfo = '09'x /*trans & dispose*/
